home *** CD-ROM | disk | FTP | other *** search
/ Kit PC World De Ampliacion De Windows 95 / Kit PC World de ampliacion de Windows 95.iso / internet / sweeper / samples / olecon~1 / wizards / transfrm.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-12-04  |  13.3 KB  |  271 lines
  1. VERSION 4.00
  2. Begin VB.Form frmTransform 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Generating OLE Control"
  5.    ClientHeight    =   1725
  6.    ClientLeft      =   4110
  7.    ClientTop       =   5520
  8.    ClientWidth     =   6090
  9.    ControlBox      =   0   'False
  10.    Height          =   2145
  11.    Left            =   4050
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   1725
  16.    ScaleWidth      =   6090
  17.    ShowInTaskbar   =   0   'False
  18.    Top             =   5160
  19.    Width           =   6210
  20.    Begin ComctlLib.ProgressBar ProgressBar1 
  21.       Height          =   255
  22.       Left            =   600
  23.       TabIndex        =   1
  24.       Top             =   840
  25.       Width           =   4815
  26.       _Version        =   65536
  27.       _ExtentX        =   8493
  28.       _ExtentY        =   450
  29.       _StockProps     =   192
  30.       Appearance      =   1
  31.    End
  32.    Begin VB.Label lblmessage 
  33.       Alignment       =   2  'Center
  34.       Caption         =   "Label1"
  35.       Height          =   495
  36.       Left            =   600
  37.       TabIndex        =   0
  38.       Top             =   120
  39.       Width           =   4695
  40.    End
  41. Attribute VB_Name = "frmTransform"
  42. Attribute VB_Creatable = False
  43. Attribute VB_Exposed = False
  44. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long _
  45. Dim m_szGuidLibid As String
  46. Dim m_szGuidPrimaryDispatch As String
  47. Dim m_szGuidEventInterface As String
  48. Dim m_szGuidCoClass As String
  49. Dim m_szGuidPropPage As String
  50. Private Sub Form_Load()
  51.     Show
  52.     On Error GoTo Blech
  53.     If Dir(szSourceDir) = "" Then
  54. Blech:
  55.         szSourceDir = InputBox("Unable to find Template files in '" + szFinalDir + "'. Please Enter an alternate location.", "Control Wizard")
  56.     End If
  57.     On Error GoTo 0
  58.     If g_fLoser = True Then szControlName = Left(szControlName, 8)
  59.     lblmessage.Caption = "Creating Directories"
  60.     Refresh
  61.     m_CreateDirs
  62.     ProgressBar1.Value = 25
  63.     lblmessage.Caption = "Generating GUIDs"
  64.     Refresh
  65.     m_MakeGUIDs
  66.     ProgressBar1.Value = 50
  67.     lblmessage.Caption = "Copying over control files"
  68.     Refresh
  69.     m_CopyFiles
  70.     ProgressBar1.Value = 75
  71.     lblmessage.Caption = "Setting up control"
  72.     Refresh
  73.     m_ReplaceNames
  74.     ProgressBar1.Value = 100
  75.     Refresh
  76. End Sub
  77. Sub m_MakeGUIDs()
  78.     m_szGuidLibid = GenerateUUID
  79.     m_szGuidPrimaryDispatch = GenerateUUID
  80.     m_szGuidEventInterface = GenerateUUID
  81.     m_szGuidCoClass = GenerateUUID
  82.     m_szGuidPropPage = GenerateUUID
  83. End Sub
  84. Private Sub m_CreateDirs()
  85.     On Error GoTo die
  86.     MkDir szFinalDir
  87.     MkDir szFinalDir + "\Release"
  88.     MkDir szFinalDir + "\Debug"
  89.     If g_fSatellite = True Then MkDir szFinalDir + "\French"
  90.     Exit Sub
  91.     MsgBox "Couldn't Create directories"
  92.     End
  93. End Sub
  94. Private Sub m_CopyFiles()
  95.     Dim s As String
  96.     If g_fLoser = True Then
  97.         s = Left(szControlName, 5)
  98.     Else
  99.         s = szControlName
  100.     End If
  101.     FileCopy szSourceDir + "\dispids.h", szFinalDir + "\Dispids.h"
  102.     FileCopy szSourceDir + "\guids.cpp", szFinalDir + "\Guids.Cpp"
  103.     FileCopy szSourceDir + "\guids.h", szFinalDir + "\Guids.H"
  104.     FileCopy szSourceDir + "\LocalObj.H", szFinalDir + "\LocalObj.H"
  105.     FileCopy szSourceDir + "\Makefile", szFinalDir + "\Makefile"
  106.     FileCopy szSourceDir + "\Resource.H", szFinalDir + "\Resource.H"
  107.     FileCopy szSourceDir + "\Template.Bmp", szFinalDir + "\" + s + "Ctl.Bmp"
  108.     FileCopy szSourceDir + "\Template.Cpp", szFinalDir + "\" + szControlName + ".Cpp"
  109.     FileCopy szSourceDir + "\Template.Def", szFinalDir + "\" + szControlName + ".Def"
  110.     FileCopy szSourceDir + "\Template.ODL", szFinalDir + "\" + szControlName + ".ODL"
  111.     If g_fSatellite = False Then
  112.         FileCopy szSourceDir + "\Template.RC", szFinalDir + "\" + szControlName + ".RC"
  113.     Else
  114.         FileCopy szSourceDir + "\TemplSat.RC", szFinalDir + "\" + szControlName + ".RC"
  115.     End If
  116.     If g_szSubClassName = "" Then
  117.         FileCopy szSourceDir + "\TemplCtl.Cpp", szFinalDir + "\" + s + "Ctl.Cpp"
  118.     Else
  119.         FileCopy szSourceDir + "\SubClCtl.Cpp", szFinalDir + "\" + s + "Ctl.Cpp"
  120.     End If
  121.     FileCopy szSourceDir + "\TemplCtl.H", szFinalDir + "\" + s + "Ctl.H"
  122.     FileCopy szSourceDir + "\templPPG.Cpp", szFinalDir + "\" + s + "PPG.Cpp"
  123.     FileCopy szSourceDir + "\templppg.h", szFinalDir + "\" + s + "PPG.H"
  124.     FileCopy szSourceDir + "\Debug\Make.Bat", szFinalDir + "\Debug\Make.Bat"
  125.     FileCopy szSourceDir + "\Release\Make.Bat", szFinalDir + "\Release\Make.Bat"
  126.     If g_fSatellite = True Then
  127.         FileCopy szSourceDir + "\French\make.bat", szFinalDir + "\French\make.bat"
  128.         FileCopy szSourceDir + "\French\Makefile", szFinalDir + "\French\Makefile"
  129.         FileCopy szSourceDir + "\French\Template.odl", szFinalDir + "\French\" + s + "Sat.Odl"
  130.         FileCopy szSourceDir + "\French\TemplSat.Cpp", szFinalDir + "\French\" + s + "Sat.Cpp"
  131.         FileCopy szSourceDir + "\French\TemplSat.Def", szFinalDir + "\French\" + s + "Sat.Def"
  132.         FileCopy szSourceDir + "\French\TemplSat.Rc", szFinalDir + "\French\" + s + "Sat.Rc"
  133.     End If
  134. End Sub
  135. Private Sub m_ReplaceNames()
  136.     Dim s As String
  137.     If g_fLoser = True Then
  138.         s = Left(szControlName, 5)
  139.     Else
  140.         s = szControlName
  141.     End If
  142.     ReplaceFile szFinalDir + "\Dispids.H", "<<DEFCONTROLNAME>>", szControlName
  143.     ReplaceFile szFinalDir + "\Dispids.H", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  144.     ReplaceFile szFinalDir + "\Dispids.H", "<<DEFCONTROLTRUNCNAME>>", s
  145.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFCONTROLNAME>>", szControlName
  146.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFSERVERNAME>>", szControlName
  147.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  148.     ReplaceFile szFinalDir + "\guids.cpp", "<<DEFCONTROLTRUNCNAME>>", s
  149.     ReplaceFile szFinalDir + "\guids.h", "<<DEFCONTROLNAME>>", szControlName
  150.     ReplaceFile szFinalDir + "\guids.H", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  151.     ReplaceFile szFinalDir + "\guids.H", "<<DEFCONTROLTRUNCNAME>>", s
  152.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFCONTROLNAME>>", szControlName
  153.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  154.     ReplaceFile szFinalDir + "\localobj.H", "<<DEFCONTROLTRUNCNAME>>", s
  155.     ReplaceFile szFinalDir + "\makefile", "<<DEFCONTROLNAME>>", szControlName
  156.     ReplaceFile szFinalDir + "\makefile", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  157.     ReplaceFile szFinalDir + "\makefile", "<<DEFCONTROLTRUNCNAME>>", s
  158.     ReplaceFile szFinalDir + "\resource.h", "<<DEFCONTROLNAME>>", szControlName
  159.     ReplaceFile szFinalDir + "\resource.h", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  160.     ReplaceFile szFinalDir + "\resource.H", "<<DEFCONTROLTRUNCNAME>>", s
  161.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFCONTROLNAME>>", szControlName
  162.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFSERVERNAME>>", szControlName
  163.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  164.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<DEFCONTROLTRUNCNAME>>", s
  165.     ReplaceFile szFinalDir + "\" + szControlName + ".cpp", "<<USESSATELLITELOCALIZATION>>", UCase(Str$(g_fSatellite))
  166.     ReplaceFile szFinalDir + "\" + szControlName + ".def", "<<DEFCONTROLNAME>>", szControlName
  167.     ReplaceFile szFinalDir + "\" + szControlName + ".def", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  168.     ReplaceFile szFinalDir + "\" + szControlName + ".def", "<<DEFCONTROLTRUNCNAME>>", s
  169.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<DEFCONTROLNAME>>", szControlName
  170.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  171.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<DEFCONTROLTRUNCNAME>>", s
  172.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_LIBID>>", m_szGuidLibid
  173.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_PRIMARYDISPATCH>>", m_szGuidPrimaryDispatch
  174.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_EVENTINTERFACE>>", m_szGuidEventInterface
  175.     ReplaceFile szFinalDir + "\" + szControlName + ".odl", "<<GUID_COCLASS>>", m_szGuidCoClass
  176.     ReplaceFile szFinalDir + "\" + szControlName + ".rc", "<<DEFCONTROLNAME>>", szControlName
  177.     ReplaceFile szFinalDir + "\" + szControlName + ".rc", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  178.     ReplaceFile szFinalDir + "\" + szControlName + ".rc", "<<DEFCONTROLTRUNCNAME>>", s
  179.     ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<DEFCONTROLNAME>>", szControlName
  180.     ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  181.     ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<DEFCONTROLTRUNCNAME>>", s
  182.     If g_szSubClassName <> "" Then ReplaceFile szFinalDir + "\" + s + "Ctl.Cpp", "<<SUBCLASSWINDOWCLASS>>", g_szSubClassName
  183.     ReplaceFile szFinalDir + "\" + s + "Ctl.h", "<<DEFCONTROLNAME>>", szControlName
  184.     ReplaceFile szFinalDir + "\" + s + "Ctl.h", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  185.     ReplaceFile szFinalDir + "\" + s + "Ctl.h", "<<DEFCONTROLTRUNCNAME>>", s
  186.     ReplaceFile szFinalDir + "\" + s + "PPG.Cpp", "<<DEFCONTROLNAME>>", szControlName
  187.     ReplaceFile szFinalDir + "\" + s + "PPG.Cpp", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  188.     ReplaceFile szFinalDir + "\" + s + "PPG.Cpp", "<<DEFCONTROLTRUNCNAME>>", s
  189.     ReplaceFile szFinalDir + "\" + s + "PPG.h", "<<DEFCONTROLNAME>>", szControlName
  190.     ReplaceFile szFinalDir + "\" + s + "PPG.h", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  191.     ReplaceFile szFinalDir + "\" + s + "PPG.h", "<<DEFCONTROLTRUNCNAME>>", s
  192.     ReplaceFile szFinalDir + "\" + "guids.H", "<<PPGGUID>>", GetPPGGuidString
  193.     If g_fSatellite = True Then
  194.         ReplaceFile szFinalDir + "\French\Makefile", "<<DEFCONTROLNAME>>", szControlName
  195.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Def", "<<DEFCONTROLNAME>>", szControlName
  196.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Rc", "<<DEFCONTROLNAME>>", szControlName
  197.         ReplaceFile szFinalDir + "\French\" + s + "Sat.Rc", "<<DEFCONTROLNAMECAPS>>", UCase(szControlName)
  198.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<DEFCONTROLNAME>>", szControlName
  199.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_LIBID>>", m_szGuidLibid
  200.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_PRIMARYDISPATCH>>", m_szGuidPrimaryDispatch
  201.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_EVENTINTERFACE>>", m_szGuidEventInterface
  202.         ReplaceFile szFinalDir + "\French\" + s + "Sat.ODL", "<<GUID_COCLASS>>", m_szGuidCoClass
  203.     End If
  204. End Sub
  205. Function ReplaceData(ByVal sData As String, ByVal sInToken As String, ByVal sOutToken As String) As String
  206.     If Len(sData) = 0 Then Exit Function
  207.     Dim iLast As Integer
  208.     Dim sPart As String
  209.     Dim sTemp As String
  210.     sTemp = sData
  211.     'Now do double quotes
  212.     iLast = InStr(sData, sInToken)
  213.     While iLast
  214.         sPart = sPart & Left$(sData, iLast - 1) & sOutToken
  215.         sData = Right$(sData, Len(sData) - iLast - Len(sInToken) + 1)
  216.         iLast = InStr(sData, sInToken)
  217.     Wend
  218.     sData = sPart & sData
  219.     'Debug.Print sData
  220.     ReplaceData = sData
  221. End Function
  222. Function ReplaceFile(ByVal sInName As String, ByVal sInToken As String, ByVal sOutToken As String) As Boolean
  223.     Dim iFNum As Integer
  224.     Dim iFOut As Integer
  225.     Dim sHead As String
  226.     Dim sTemp As String
  227.     On Error GoTo fncopnerr
  228.     'Open the files
  229.     iFNum = FreeFile
  230.     Open sInName For Input As #iFNum
  231.     iFOut = FreeFile
  232.     Open szFinalDir + "\moo.Tmp" For Output As #iFOut
  233.     Do Until EOF(iFNum)
  234.         Line Input #iFNum, sTemp
  235.         sTemp = ReplaceData(sTemp, sInToken, sOutToken)
  236.         Print #iFOut, sTemp
  237.     Loop
  238.     Close #iFNum
  239.     Close #iFOut
  240.     Kill sInName
  241.     Name szFinalDir + "\moo.tmp" As sInName
  242.     ReplaceFile = True
  243.     Exit Function
  244. fncopnerr:
  245.         MsgBox "Reap File Error - " & Error$ & ""
  246.         ' Resume
  247.         ReplaceFile = False
  248.         Exit Function
  249. End Function
  250. Function GenerateUUID() As String
  251.     Shell "uuidgen -oMaggots.987"
  252.     Call Sleep(2000)
  253.     Open "Maggots.987" For Input As 1
  254.     Line Input #1, GenerateUUID
  255.     Close #1
  256.     Kill "maggots.987"
  257. End Function
  258. Function GetPPGGuidString() As String
  259.     Dim s As String
  260.     s = "DEFINE_GUID(CLSID_" + szControlName + "GeneralPage, 0x" + Left(m_szGuidPropPage, 8) _
  261.         + ", 0x" + Mid(m_szGuidPropPage, 10, 4) + ", 0x" + Mid(m_szGuidPropPage, 15, 4) _
  262.         + ", 0x" + Mid(m_szGuidPropPage, 20, 2) + ", 0x" + Mid(m_szGuidPropPage, 22, 2) _
  263.         + ", 0x" + Mid(m_szGuidPropPage, 25, 2) + ", 0x" + Mid(m_szGuidPropPage, 27, 2) _
  264.         + ", 0x" + Mid(m_szGuidPropPage, 29, 2) + ", 0x" + Mid(m_szGuidPropPage, 31, 2) _
  265.         + ", 0x" + Mid(m_szGuidPropPage, 33, 2) + ", 0x" + Mid(m_szGuidPropPage, 35, 2) _
  266.         + ");"
  267.     GetPPGGuidString = s
  268. End Function
  269. Private Sub lblmessage_Click()
  270. End Sub
  271.